00100		TITLE MSSIO ; ********* JUN 8,74 *********
00200	;;	INTERNAL GETFI2,FASTI2,LOOP
00205		INTERNAL GETFI2,FASTI2
00210		INTERNAL LOOK,LOOKD,LOOKF,PAC,UNPAC
00300	
00400	
00500		CH3←15	;WAS ←13  4/18/75 *******
00600	
00700	DEFINE ERROR (MSG)
00800	<	JSA 16,.ERROR
00900		JUMP [ASCIZ/MSG/
01000	]
01100	>
01200	
01500	;CALL GETFI2(<FILE>)
01600	
01700	GETFI2:	0
01800		MOVE 0,@0(16)
01900		MOVEM 0,FILNAM
02000		JSA 16,INTFIZ
02100		MOVE 0,[SIXBIT/DMD/]
02200		MOVEM 0,DIR+1
02300		JSA 16,LKUP
02400		SKIPA
02500		JRST GETF3
02600		SETZM DIR+1
02700		JSA 16,LKUP
02800		0
02900	GETF3:	JRA 16,1(16)
03000	
03100	LKUP:	0
03200		SETZM DIR+2
03300		SETZM DIR+3
03400		LOOKUP CH3,DIR
03500		JRA 16,0(16)
03600		JRA 16,1(16)
03700	
03800	INTFIZ:	0	;INITS DSK FOR INPUT
03900		MOVEI REGS
04000		BLT REGS+3
04100		INIT CH3,17
04200		SIXBIT/DSK/
04300		0
04400		ERROR <CAN'T INIT DSK!>
04500		JRST INTF4
04600	
04900	
05000	;CALL FASTI2(<ARRAY>,<NO. WORDS>)
05100	
05200	FASTI2:	0
05300		HRRZ 0,0(16)
05400		SUBI 0,1
05500		MOVEM 0,COM
05600		MOVN 0,@1(16)
05700		HRLM 0,COM
05800		INPUT CH3,COM
05900		STATZ CH3,740000
06000		0
06100		JRA 16,2(16)
06200	
06300	COM:	OCT 0,0
06400	BLKNUM:	0
08200	
08300	.ERROR:	0
08400		OUTSTR [ASCIZ/?
08500	/]				;MAKE SURE HE CAN SEE HIS ERROR
08600		OUTSTR @(16)		;OUTPUT ERROR MESSAGE
08700		CALLI 1,12		;LET USER CONTI2UE
08800		JRA 16,1(16)
     

00300	
00400		CH←13
00500	
00600	REGS:	BLOCK 20
00700	
00800	;LOOK(<FILE>) FOR NO EXT., LOOKD() FOR .DAT, LOOKF() FOR .DMD
00900	
01000	LOOKF:	0
01100		MOVSI 0,'DMD'
01200		JRST LOOK1
01300	LOOKD:	0
01400		MOVSI 0,'DAT'
01500		JRST LOOK1
01600	LOOK:	0
01700		MOVEI	0,0
01800	LOOK1:	MOVEM	0,DIR+1
01900		MOVE	0,@(16)
02000		MOVEM 	0,FILNAM
02100		JSA 16, INTFIQ
02200		SETZM	DIR+2
02300		SETZM	DIR+3
02400		LOOKUP	CH,DIR
02500		TDZA	0,0
02600		MOVNI	0,1
02700		JRA 16,1(16)
02800	
02900	INTFIQ:	0	;INITS DSK FOR INPUT
03000		MOVEI REGS
03100		BLT REGS+3
03200		INIT CH,17
03300		SIXBIT/DSK/
03400		0
03500		HALT .-3
03600	;	ERROR <CAN'T INIT DSK!>
03700	
03800	INTF4:	MOVE 0,FILNAM#
03900		MOVEM 0,FN#
04000		MOVE 1,[POINT 7,FN]
04100	INTF3:	MOVE 2,[POINT 6,DIR]
04200		SETZM DIR
04300		MOVEI 3,5
04400	INTF1:	ILDB 0,1
04500		CAIN 0," "
04600		JRST INTF2
04700		SUBI 0,40
04800		IDPB 0,2
04900		SOJG 3,INTF1
05000	INTF2:	HRLZI REGS
05100		BLT 3
05200		JRA 16,0(16)
05300	
05400	DIR:	BLOCK 4
05500	
05600	
05700	PAC:	0		;CALL PAC(PW,AR)
05800		HRRZ 4,1(16)	; ******* USES AC'S 4,5,6 ********
05900		ADDI 4,2
06000		HRR 5,@4	;SIZE IS 12 BITS
06100		LSHC 5,-10
06200		SOJ 4,
06300		HRR 5,@4
06400		LSHC 5,-16
06500		SOJ 4,
06600		HRR 5,@4
06700		LSHC 5,-16
06800		MOVEM 6,@0(16)
06900		JRA 16,2(16)
07000	UNPAC:	0		;CALL UNPAC(PW,AR)
07100		HRRZ 1,1(16)
07200		ADDI 1,2
07300		MOVE 2,@0(16)
07400		LSHC 2,-10	; 14 BITS, 14 BITS, 8 BITS
07500		ASH 3,-34
07600		MOVEM 3,@1
07700		SOJ 1,
07800		LSHC 2,-16
07900		ASH 3,-26
08000		MOVEM 3,@1
08100		SOJ 1,
08200		LSHC 2,-16
08300		ASH 3,-26
08400		MOVEM 3,@1
08500		JRA 16,2(16)
08550	
08700	
08800	;	SUBROUTINE LOOP(I,J,K,L,M,N)
08900	;	DIMENSION N(1)
09000	;	DO 1 NN=I,J,K
09100	;1	N(NN+L)=N(NN+M)
09200	;	END
09300	
09400	;;LOOP:	0
09500	;;	MOVE 4,@1(16)
09600	;;	MOVE 3,@0(16)
09700	;;	SUB 4,3
09800	;;	HRRZ 2,5(16)
09900	;;	SOJ 2,
10000	;;	ADD 2,3
10100	;;	JUMPL 4,MIMI
10200	;;	HRR 5,2
10300	;;	ADD 5,@3(16)
10400	;;	ADD 4,2
10500	;;	ADD 4,@3(16)
10600	;;	ADD 2,@4(16)
10700	;;	HRL 5,2
10800	;;	BLT 5,(4)
10900	;;	JRA 16,6(16)
11000	;;MIMI:	HRR 5,@4(16)
11100	;;	HRRM 5,XN
11200	;;	HRR 5,@3(16)
11300	;;	HRRM 5,XN+1
11400	;;XN:	MOVE 6,(2)
11500	;;	MOVEM 6,(2)
11600	;;	SOJ 2,
11700	;;	AOJL 4,XN
11800	;;	JRA 16,6(16)
11900		END